COMMENT ⊗   VALID 00017 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	COMMENT 
C00004 00003	Fields and data:  ALDOPS, BRKTAB
C00008 00004	 INTERP
C00011 00005	 TYPVAL
C00015 00006	I/O routines:  TYPR50, INCHR, INOCT, INR50
C00019 00007	 BRACE
C00023 00008		take care of break case
C00029 00009	 NEWBRK, FNDBRK
C00031 00010	 TPPSOP
C00034 00011	 TYPADR, TYPOFS, INADR, INOFS
C00037 00012	  Data structures:  Notes, note cells, message buffers
C00038 00013	  GETNOTE, SNDNOTE, SERVER
C00042 00014	  DOGTBUF, DOUSBUF, DORLBUF
C00045 00015	  TREATMESSAGE
C00047 00016	  Driver for test of communications
C00048 00017	! new stuff:  KTABLE, LOOKUP
C00050 ENDMK
C⊗;
;COMMENT ⊗
.TITLE  Test of ALAID

.IF1
    .INSRT HALHED.PAL[HAL,HE]
    .INSRT K2DEF.PAL[11,SYS]
.ENDC
. = INTRP
.INSRT HALIO.PAL[HAL,HE]
.INSRT LARGEB.PAL[HAL,HE]
;⊗
;Fields and data:  ALDOPS, BRKTAB

COMMENT ∩ Leave all this out for communications test.
COMMENT ⊗ ALAID information resides in the ALDOPS table parallel to
the INTOPS table.  Each psuedo-op has these fields: ⊗

	II == 0
	XX ALDFLG	;Holds bits indicating status of tracing
	    ALDBRK == 1	; Break bit.  When set, break on this psop.
	    ALDTRC == 2	; Tracing bit.  When set, trace this psop.
	XX ALDARG	;Encoding the types of arguments taken by this psop.
	XX ALDPNM	;The RAD50 print name of the psop.  Two words
	    II == II + 2
	OPSLTH == II/2	;Number of words in each ALDOPS entry

	.MACRO MAKEOP CNAME, ANAME, TYPES
	    ;Compiler name, Address name, Types of arguments
	II == .
	0		;ALDFLG
            III == 0
            II2 == 1
                .IRP ARG,<TYPES>
                    .IF NB ARG
                    III == II2*ARG + III
                    II2 == 8*II2
                    .ENDC
                .ENDM
	III		;ALDARG

	.RAD50 /ANAME/	;ALDPNM
	. = II + OPSLTH	+ OPSLTH;Just in case the ANAME was funny
	.ENDM

	A == 1
	LA == 2
	O == 3
	LO == 4
	N == 5
	R50 == 6

; The interpreter operation debug table
ALDOPS: MAKEOP XINVALID,INVALD		;Illegal instruction
	.INSRT	INTOPS.PAL[HAL,HE]

COMMENT ⊗ There is a fixed number of available bracepoints.  (Break
or trace points).  When a bracepoint is in place, the old contents of
the instruction are stored in the breakpoint table.  Bracepoints are
always kept in place. ⊗
	II == 0
	XX OLDPSOP 	;Saved contents of psinstruction
	XX OLDADR	;Where it comes from
	XX BRCWHA	;Flags saying what to do.
	    ALDBRK == 1 ; Break bit.  When set, this is a break point.
	    ALDTRC == 2	; Tracing bit.  When set, this is a tracepoint.
	BRKLTH == II/2	;Number of words in each entry

BRKNO == 10		;Number of breakpoints available
BRKTAB:	.BLKW BRKLTH*BRKNO
BRKDUM:	.BLKW BRKLTH	;One dummy break table entry for bad entries
	
; INTERP

	.MACRO BMPIPC	;
	ADD #2,IPC(R4)	;Bump IPC
	.ENDM		;

COMMENT ⊗ This is the interpreter loop which replaces the one in
INTERP.PAL.  It does bounds checking for the instruction, then
catches single step, special traps or traces on this instruction
type, then breakpoints or tracepoints in the code.  Finally it calls
the appropriate interpeter routine.  ⊗

INTERP:
	MOV R3,R0	;Save the limit of the interpreter stack for error checking.
	SUB #INSTSZ-2,R0	
	MOV R0,-(SP)	;
INT1:	CMP R3,(SP)	;Interpreter stack overflow?
	BGE INT3	;No.  Go to next instruction.
	HALERR INTMS3	;Yes.  Complain.
INT3:	MOV @IPC(R4),R0	;R0 ← next instruction
	BLE INVALID	;Instruction out of range
	CMP R0,#INSEND	;Is instruction too large?
	BLE INT2	;No.
INVALID:HALERR INTMS1	;Yes. complain.
INT2:	BMPIPC		;Bump IPC

	;catch single step
	BIT #ALDSS,DEBMOD(R4)	;Single step?
	BEQ INT4	;No
INT5:	JSR PC,BRACE	;R0 ← proper psop to execute
	BR  INTDO	;Now do the instruction

 	;catch break on instruction type
INT4:	MOV #OPSLTH,R1	;
	MUL R0,R1	;
	ADD #ALDOPS,R1	;
	MOV R1,R2	;R2 ← pointer into ALDOPS
	BIT #ALDBRK,ALDFLG(R2)	;Break?
	BNE INT5	;Yes.

	;catch brace instruction
	CMP #XBRACE,R0	;Is it a brace instruction?
	BEQ INT5	;Yes.

	;catch trace on instruction type
	BIT #ALDTRC,ALDFLG(R2)	;Trace?
	BEQ INTDO	;No.
	JSR PC,TRACE	;Yes.

INTDO:	JSR PC,@INTOPS(R0)	;Call the appropriate routine
	BR  INTCPL(R0)	;R0 should have an completion code.  Branch accordingly.

INTCPL: BR  INT1	;No error.  Repeat.
	HALERR INTMS2	;Error.  Complain.
	BR INT1		;And repeat.

INTMS1:	ASCIE /INTERPRETER INSTRUCTION OUT OF RANGE/
INTMS2:	ASCIE /INTERPRETED INSTRUCTION RETURNED FAILURE/
INTMS3:	ASCIE /INTERPRETER STACK OVERFLOW/
; TYPVAL

TYPVAL:
COMMENT ⊗ R0 points to a value cell.  Prints it according to its
type.  Requires the floating package.  ⊗
	MOV R2,-(SP)	;Save R2
	MOV R0,R2	;R2 ← LOC[value cell]
	MOV #CRLFX,R0	;CRLF
	JSR PC,TYPSTR	;
	MOVB TAGID(R2),R1
	CMPB #SCLID,R1	;A scalar?
	BEQ TYPVL1	;
	CMPB #VCTID,R1	;A vector?
	BEQ TYPVL4	;
	CMPB #TRNID,R1	;A trans?
	BEQ TYPVL5	;
TYPVL1:	MOV #SNAME,R0	;
	JSR PC,TYPSTR	;"SCALAR "
	MOV #OUTBUF,R0	;
TYPVL2:	LDF (R2),AC0	;
	JSR PC,CVG	;
	MOV #OUTBUF,R0	;
	JSR PC,TYPSTR	;
TYPVL3:	MOV #CRLFX,R0	;CRLF
	JSR PC,TYPSTR	;
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done
TYPVL4:	MOV #VNAME,R0	;
	JSR PC,TYPSTR	;"VECTOR "
	MOV #OUTBUF,R0	;
	LDF (R2)+,AC0	;
	JSR PC,CVG	;
	LDF (R2)+,AC0	;
	JSR PC,CVG	;
	BR  TYPVL2	;Bum code for last field.
TYPVL5:	MOV #TNAME,R0	;
	JSR PC,TYPSTR	;"TRANS "
	MOV R3,-(SP)	;Save R3
	MOV #4,R3	;R3 ← Number of rows
TYPVL6:	MOV #CRLFX,R0	;
	JSR PC,TYPSTR	;
	MOV #OUTBUF,R0	;
	LDF (R2),AC0	;
	JSR PC,CVG	;
	LDF 20(R2),AC0	;
	JSR PC,CVG	;
	LDF 40(R2),AC0	;
	JSR PC,CVG	;
	LDF 60(R2),AC0	;
	JSR PC,CVG	;
	MOV #OUTBUF,R0	;
	JSR PC,TYPSTR	;
	ADD #4,R2	;Next row
	SOB R3,TYPVL6	;
	MOV (SP)+,R3	;Restore R3
	BR  TYPVL3	;Go to the exit stage

SNAME:	ASCIE /SCALAR /
VNAME:	ASCIE /VECTOR /
TNAME:	ASCIE /TRANS /
;I/O routines:  TYPR50, INCHR, INOCT, INR50

;Type contents of R0 as RAD50
TYPR50:	MOV R0,R1	;Arg in R1
	CLR -(SP)	;Sentinel
	JSR PC,TPR51	;
	TST (SP)+	;
TPR54:	RTS PC		;Done
TPR51:	CLR R0
	DIV #50,R0	;Do one reduction
	BEQ TPR52	;Down to zero yet?
	MOV R1,-(SP)	;Stack remainder.
	MOV R0,R1
	JSR PC,TPR51	;And do it again.
	MOV (SP)+,R1	;R1 ← saved remainder.
TPR52:	TST R1		;Zero?  
	BEQ TPR54	;Yes.  Flush it.
	CMP R1,#33	;Letter, dollar?
	BLT TPRLET	;Yes, letter
	BEQ TPRDOL	;Yes, dollar
	CMP R1,#35	;Percent?
	BEQ TPRPER	;Yes
	ADD #22,R1	;point or number
TPR53:	MOV R1,R0	;Ready to print
	JMP TYPCHR	;TYPCHR will do the returning

TPRLET:	ADD #100,R1
	BR TPR53

TPRDOL:	MOV #'$,R0
	JMP TYPCHR

TPRPER:	MOV #'%,R0
	JMP TYPCHR

;  Waits for a character to be typed, returns it in R0.  Does not echo.
INCHR:	TST OUTSW	;VT05 or console?
	BEQ INCHR2	;console
	TSTB KBIS	;VT05 input ready?
	BNE INCHR1	;Yes.
INCHR3:	SLEEP #1	;No.  Wait a while
	BR INCHR	;And try again
INCHR1:	MOVB KBIR,R0	;Get a character
	BIC #177600,R0	;Make off to make it 7 bits
	RTS PC 		;Done
INCHR2:	MOV IREG,R0	;Get a character
	BEQ INCHR3	;Nothing there
	CLR IREG	;Clear it for next character
	RTS PC		;Done.

INR50:
COMMENT ⊗ Reads an alphameric string, returns the RAD50
representation in R0 and R1.  Any characters after the 6th are lost.
Input terminated by any illegal RAD50 character.  Backspace works.  ⊗

INOCT:
COMMENT ⊗ Reads an octal number, returns it in R0.  Any non-digit
terminates the number.  Backspace will work properly.  Echoes.  ⊗
	MOV R2,-(SP)	;Save R2
	CLR R2		;R2 is the eventual result
INCT3:	JSR PC,INCHR	;R0 ← Character
	CMP #177,R0	;Backspace?
	BNE INCT4	;No
	ASH #-3,R2	;Get rid of last digit
	MOV #DBS,R0	;Peform deleting backspace.  Defined in HALIO
	JSR PC,TYPSTR	;
	BR  INCT3	;Go back.
INCT4:	CMP #'0,R0	;Too small?
	BGT INCT1	;yes
	CMP #'7,R0	;Too large?
	BGE INCT2	;no
INCT1:	MOV #40,R0	;type a trailing " "
	JSR PC,TYPCHR	;
	MOV R2,R0	;R0 ← result
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done
INCT2:	MOV R0,-(SP)	;Save the character
	JSR PC,TYPCHR	;Echo it
	ASH #3,R2	;Compute new result
	BIC #60,(SP)	;
	ADD (SP)+,R2	;
	BR  INCT3	;And repeat
; BRACE

BRACE:
COMMENT ⊗ 
This routine can be called from anywhere.  It expects that IPC(R4)
has been bumped once since the last instruction was fetched, that is,
the instruction is at IPC(R4)-2.  The currently implemented
operations are:
	DDT		go to DDT, where <alt>P will return to here.
	PROCEED		exits this routine to whoever called it.
	BREAK <adr>	puts a breakpoint at <adr>
	TRACE <adr>	puts a tracepoint at <adr>
	UNBRACE <adr>	removes all bracepoints from <adr>
	EXAMINE <lev-of>examines a variable
	SINGLE STEP	puts a trap on the next instruction, proceeds.
	RESET		remove all breakpoints.
When this routine exits, it has put the psop that it found in R0.  If
the psop was <BREAK>, then the correct equivalent is either <NOOP>
for bad entry or the old psop for bracepoints.  ⊗

	;look up the instruction in the brace table.
	MOV R2,-(SP)	;Save R2
	MOV IPC(R4),R0	;
	SUB #2,R0	;R0 ← address of broken instruction
	JSR PC,FNDBRK	;R1 ← LOC[entry in break table], 0 for none found. R0←R0
	MOV R1,R2	;R2 ← LOC[entry in break table]
	BNE BRK1	;if any
	MOV #BRKDUM,R2	;nope.  use the dummy break instruction.
	MOV (R0),OLDPSOP(R2)	;initialize it.
	MOV R0,OLDADR(R2);
	MOV #ALDBRK,BRCWHA(R2)	;
	BR  BRK2	;We know it is a break

	;see if it is a break or a trace
BRK1:	BIT #ALDSS,DEBMOD(R4)	;Single step?
	BEQ BRK3	;No
	BIC #ALDSS,DEBMOD(R4)	;Turn it off.
	MOV #BRKM00,R0	;":SS:<cr>"
	JSR PC,TYPSTR	;
	BR BRK5		;And otherwise just like a break.
BRK3:	BIT #ALDBRK,BRCWHA(R2)	;Is the break bit on?
	BNE BRK2	;Yes
	BIT #ALDTRC,BRCWHA(R2)	;The trace bit, then?
	BEQ BRK4	;No.

	;take care of trace case
TRACE:	MOV #TRCMS,R0	;Yes.  "<cr>:TRC:"
	JSR PC,TYPSTR	;
	MOV IPC(R4),R0	;
	SUB #2,R0	;R0 ← LOC[psop]
	JSR PC,TYPADR	;Tell where we are.
	MOV OLDPSOP(R2),R0;Tell what psop
	MOV OLDADR(R2),R1;
	ADD #2,R1	;R1 ← LOC[argument(s)]
	JSR PC,TPPSOP	;
	JMP BRKPC1	;Go to the return place.
BRK4:	MOV (SP)+,R2	;Restore R2
	RTS PC		;And exit.

	;take care of break case
BRK2:	MOV #BRKMS1,R0	;":BRK:<cr>"
	JSR PC,TYPSTR	;
BRK5:	MOV IPC(R4),R0	;
	SUB #2,R0	;R0 ← address of broken instruction
	JSR PC,TYPADR	;Tell where we are.
	MOV OLDPSOP(R2),R0;Tell what psop
	MOV OLDADR(R2),R1;
	ADD #2,R1	;R1 ← LOC[argument(s)]
	JSR PC,TPPSOP	;
BRKALD:	MOV #BRKMS0,R0	;Prompt
	JSR PC,TYPSTR	;
	JSR PC,INCHR	;See what the user wants to do.
	CMP #15,R0	;Carriage return?
	BNE BRKPRC	;No.
	MOV #CRLFX,R0	;
	JSR PC,TYPSTR	;
	BR  BRKALD	;
BRKPRC:	CMP #'P,R0	;Proceed?
	BNE BRKDDT	;
	MOV #BRKMS2,R0	;
	JSR PC,TYPSTR	;
BRKPC1:	MOV OLDPSOP(R2),R0	;Load up the psop
	MOV (SP)+,R2	;Restore R2
	RTS PC		;and return
BRKDDT:	CMP #'D,R0	;DDT?
	BNE BRKBRK	;
	MOV #BRKMS3,R0	;
	JSR PC,TYPSTR	;
	BPT		;
	BR BRKALD	;
BRKBRK:	CMP #'B,R0	;Break?
	BNE BRKUNB	;
	MOV #BRKMS4,R0	;
	JSR PC,TYPSTR	;
	JSR PC,INADR	;R0 ← address to put a break point.
	BEQ BRKHUH	;If reasonable
	MOV R0,-(SP)	;Save it
	JSR PC,NEWBRK	;R0 ← nice place in the break table
	BEQ BRKHUH	;If any
	MOV @0(SP),OLDPSOP(R0)
	MOV (SP),OLDADR(R0)
	MOV #ALDBRK,BRCWHA(R0)
	MOV #XBRACE,@(SP)+
	BR BRKALD	;
BRKUNB:	CMP #'U,R0	;Unbreak?
	BNE BRKREF	;
	MOV #BRKMS5,R0	;
	JSR PC,TYPSTR	;
	JSR PC,INADR	;R0 ← address to remove break point from.
	BEQ BRKHUH	;If reasonable
	JSR PC,FNDBRK	;R1 ← LOC[entry in break table], R0 unchanged
	BEQ BRKHUH	;
	MOV OLDPSOP(R1),@OLDADR(R1)	;Replace old instruction
	;note that we do NOT clear the OLDPSOP field; we may need it to proceed.
	CLR OLDADR(R1)	;
	BR BRKALD	;
BRKREF:	CMP #'R,R0	;Refresh?
	BNE BRKVAR	;
	MOV #BRKMS8,R0	;
	JSR PC,TYPSTR	;
	MOV #BRKNO,R1	;R1 ← Count of breakpoints
	MOV #BRKTAB,R0	;R0 ← Pointer into break table
BRKR1:	TST OLDADR(R0)	;A real break, or empty?
	BEQ BRKR2	;Empty
	MOV OLDPSOP(R0),@OLDADR(R0)	;Replace old instruction
	;note that we do NOT clear the OLDPSOP field; we may need it to proceed.
	CLR OLDADR(R0)	;
BRKR2:	SOB R1,BRKR1	;Repeat as necessary
	BR BRKALD	;
BRKVAR:	CMP #'E,R0	;Examine variable?
	BNE BRKSS	;
	MOV #BRKMS6,R0	;
	JSR PC,TYPSTR	;
	JSR PC,INOFS	;R0 ← level-offset of variable
	JSR PC,GETARG	;R0 ← LOC[LOC[graph node]
	MOV (R0),R0	;R0 ← LOC[Graph node]
	MOV GNVAL(R0),R0;R0 ← LOC[value cell]
	JSR PC,TYPVAL	;Print it.
	BR BRKALD	;
BRKSS:	CMP #'S,R0	;Single step?
	BNE BRKTRC	;
	MOV #BRKMS7,R0	;
	JSR PC,TYPSTR	;
	BIS #ALDSS,DEBMOD(R4)	;Set for single step
	BR  BRKPC1	;and just proceed
BRKTRC:	CMP #'T,R0	;Trace?
	BNE BRKHUH	;
	MOV #BRKMS9,R0	;
	JSR PC,TYPSTR	;
	JSR PC,INADR	;R0 ← address to put a trace point.
	BEQ BRKHUH	;If reasonable
	MOV R0,-(SP)	;Save it
	JSR PC,NEWBRK	;R0 ← nice place in the break table
	BEQ BRKHUH	;If any
	MOV @0(SP),OLDPSOP(R0)
	MOV (SP),OLDADR(R0)
	MOV #ALDTRC,BRCWHA(R0)
	MOV #XBRACE,@(SP)+
	JMP BRKALD	;
BRKHUH:	MOV #'π,R0	;
	JSR PC,TYPCHR	;
	JMP BRKALD	;
TRCMS:	ASCIE </
:TRC: />
BRKM00:	ASCIE </
:SS: />
BRKMS0:	ASCIE </NU? />
BRKMS1:	ASCIE </
:BRK: />
BRKMS2:	ASCIE /PROCEED /
BRKMS3:	ASCIE /DDT /
BRKMS4:	ASCIE /BREAK /
BRKMS5:	ASCIE /UNBRACE /
BRKMS6:	ASCIE /EXAMINE VARIABLE /
BRKMS7:	ASCIE /SINGLE STEP /
BRKMS8:	ASCIE /REFRESH /
BRKMS9:	ASCIE /TRACE /
; NEWBRK, FNDBRK

FNDBRK:
COMMENT ⊗ Sets R1 to the entry in the break table which corresponds
to the pseudo-code address in R0.  Does not change R0.  If none is
found, returns 0 in R1.  ⊗
	MOV R2,-(SP)	;Save R2
	MOV #BRKNO,R2	;R2 ← count of possible breakpoints
	MOV #BRKTAB,R1	;R1 ← Pointer into break table
FNDBR1:	CMP R0,OLDADR(R1)
	BEQ FNDBR2	;found
	ADD #2*BRKLTH,R1;not yet found
	SOB R2,FNDBR1	;
	CLR R1		;will never find
FNDBR2:	MOV (SP)+,R2	;Restore R2
	TST R1		;So the caller won't have to.
	RTS PC		;Done

NEWBRK:	
COMMENT ⊗ Finds an empty location in the break table.  If there is
none, returns a 0.  Result is in R0.  ⊗
	MOV #BRKTAB,R0	;First try
FNDB2:	TST OLDADR(R0)	;Anything there?
	BNE FNDB1	;Yes.
	TST R0		;So caller won't have to.
	RTS PC		;No.  All is well
FNDB1:	ADD #2*BRKLTH,R0;Try next one.
	CMP R0,#BRKDUM	;if any
	BLT FNDB2	;
	CLR R0		;none left
	RTS PC		;Done.
; TPPSOP

TPPSOP:
COMMENT ⊗ R0 holds the pseudo-instruction code, R1 points to
the argument (s).  Print out the whole thing, using the information
in the ALDOPS for argument types.  ⊗
	MOV R2,-(SP)	;Save R2
	MOV R3,-(SP)	;Save R3
	MOV R4,-(SP)	;Save R4
	MOV R1,R4	;R4 ← LOC[argument(s)]
	MOV #OPSLTH,R3	;
	MUL R0,R3	;
	ADD #ALDOPS,R3	;R3 ← ponter into ALDOPS
	MOV ALDPNM(R3),R0	;Print name of psop
	JSR PC,TYPR50	;
	MOV ALDPNM+2(R3),R0;
	JSR PC,TYPR50	;
	MOV #40,R0	;" "
	JSR PC,TYPCHR	;
	MOV ALDARG(R3),R2	;R2 ← type of arguments
TPPS3:	MOV R2,R3	;
	BNE TPPS1	;Are there more?
	MOV (SP)+,R4	;No.  Restore R4
	MOV (SP)+,R3	;Restore R3
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done
TPPS1:	CLR R2		;Yes
	DIV #8,R2	;R2 ← the next type, R3 ← this type
	ADD R3,R3	;Chnage it to byte jump count
	JMP @TPPS0(R3)	;go to the appropriate routine
	BR  TPPS3	;Then do the next one
TPPS0:	0		;
	TPPSA		;
	TPPSLA		;
	TPPSO		;
	TPPSLO		;
	TPPSN		;
TPPSA:	MOV (R4)+,R0	;R0 ← the address
	JSR PC,TYPADR	;Print it
	BR TPPS3	;
TPPSLA:	MOV (R4)+,R0	;R0 ← the next address
	BEQ TPPS3	;if any
	JSR PC,TYPADR	;Print it
	BR  TPPSLA	;And do it again.
TPPSO:	MOV (R4)+,R0	;R0 ← level-offset
	JSR PC,TYPOFS	;Print it
	BR TPPS3	;
TPPSLO:	MOV (R4)+,R0	;R0 ← level-offset
	BEQ TPPS3	;If any
	JSR PC,TYPOFS	;Print it
	BR TPPSLO	;And do it again
TPPSN:	MOV (R4)+,R0	;R0 ← the number
	JSR PC,TYPOCT	;Print it
	MOV #40,R0	;" "
	JSR PC,TYPCHR	;
	BR TPPS3	;
; TYPADR, TYPOFS, INADR, INOFS

TYPADR:  
COMMENT ⊗ R0 holds an address in pseudo-code space.  Print it out
symbolically.  Temporarily, the printout is just octal.  ⊗
	JSR PC,TYPOCT	;
	MOV #40,R0	;
	JSR PC,TYPCHR	;
	RTS PC		;

INADR:	
COMMENT ⊗ Reads from the tty a symbolic address.  Returns the octal
equivalant in R0.  Temporarily just reads in octal.  If the address
is faulty, returns 0. 
⊗
	JSR PC,INOCT	;
	BIT #1,R0	;Odd?
	BNE INADR2	;Yes
	CMP #PCODE,R0	;No. In range?
	BLE INADR1	;Yes
INADR2:	CLR R0		;No.  
INADR1:	TST R0		;So the caller won't have to.
	RTS PC		;

TYPOFS:
COMMENT ⊗ R0 holds a level-offset pair.  Print it out symbolically.
Temporarily, the printout is just "<level,offset>"  ⊗
	MOV R0,-(SP)	;Save the argument
	MOV #'<,R0	;
	JSR PC,TYPCHR	;
	CLR R0		;
	MOVB 1(SP),R0	;The level
	JSR PC,TYPOCT	;
	MOV #',,R0	;
	JSR PC,TYPCHR	;
	CLR R0		;
	MOVB (SP)+,R0	;The offset
	JSR PC,TYPOCT	;
	MOV #'>,R0	;
	JSR PC,TYPCHR	;
	MOV #40,R0	;" "
	JSR PC,TYPCHR	;
	RTS PC		;

INOFS:	
COMMENT ⊗ Reads from the tty a level-offset pair, which it returns in
R0.  Temporarily just reads an octal offset, no level. ⊗
	JSR PC,INOCT	;
	BIC #177400,R0	;Just wipe out any level
	RTS PC		;
;∩  end of commented out portion for pure communications test
;  Data structures:  Notes, note cells, message buffers

;  Notes from 10 to 11:
GETBUF == 1	;
USEBUF == 2	;
RELBUF == 3	;

;  Notes from 11 to 10:
BUFALC == 101	;
TAKBUF == 102	;

;  Offsets in notes:
ARG1 == 2
ARG2 == 4

;  Offsets in message buffers:
MESID == 0	;
MESTYP == 2	;
    FROMTEN == 1	;
    FROMELF == 2	;
    REQUEST == 4	;
    ANSWER == 10	;
MESLTH == 4	;
MESBEG == 6	;

NOTB10 = 100000	;  The notebox from 11 to the 10 (byte address)
NOTB11 = 100020	;  The notebox from 10 to the 11 (byte address)
NOTSIZ == 3		;  In WORDS!
;  GETNOTE, SNDNOTE, SERVER

GETNOTE:
COMMENT ⊗ Returns the first note seen in a block pointed to by R0. ⊗
	MOV R2,-(SP)	;Save R2
GTN2:	TST NOTB11	;Anything there?
	BNE GTN1	;Yes
	SLEEP #100	;No, so sleep a while
	BR  GTN2	;And try again
GTN1:	MOV #NOTSIZ,R0	;
	MOV R0,R2	;R2 ← Count of how many words to transfer
	JSR PC,GTFREE	;R0 ← place to store the note
	MOV #NOTB11,R1	;Transfer the note
GTN3:	MOV (R1)+,(R0)+	;
	SOB R2,GTN3	;Repeat
	SUB #2*NOTSIZ,R0	;Reset R0 to point to front of note.
	CLR NOTB11	;Clear the note, to say we got it.
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

SNDNOTE:
COMMENT ⊗ R0 point to a note to send.  Send it and then release the
block. ⊗
	MOV R2,-(SP)	;Sve R2
SDN2:	TST NOTB10	;Anything there?
	BEQ SDN1	;No.
	SLEEP #100	;Yes, so sleep a while
	BR  SDN2	;And try again
SDN1:	MOV #NOTSIZ-1,R1	;R1 ← count of words to send
	MOV #NOTB10+2,R2;R2 ← Where to put it.
	TST (R0)+	;Skip the first word; we will put it in last
SDN3:	MOV (R0)+,(R2)+	;
	SOB R1,SDN3	;Repeat
	SUB #2*NOTSIZ,R0	;Reset R0 ← LOC[note]
	MOV (R0),NOTB10	;Activate the note by sending the first word
	JSR PC,RLFREE	;Release the block.
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

SERVER:
COMMENT ⊗ Listens for one note from the 10 and acts on it. ⊗
	MOV R2,-(SP)	;Save R2
	JSR  PC,GETNOTE	;R0 ← LOC[note]
	MOV (R0),R1	;R1 ← type of note
	MOV R0,R2 	;R2 ← LOC[note]

	CMP R1,#GETBUF	;GETBUF
	BNE SRV1 	;
	JSR PC,DOGTBUF	;
	BR SRV0		;
SRV1:
	CMP R1,#USEBUF	;USEBUF
	BNE SRV2 	;
	JSR PC,DOUSBUF	;
	BR SRV0		;
SRV2:
	CMP R1,#RELBUF	;RELBUF
	BNE SRV3 	;
	JSR PC,DORLBUF	;
	BR SRV0		;
SRV3:
	HALERR SRVMES 	;Illegal code

SRV0:	MOV R2,R0	;Release the note.
	JSR PC,RLFREE	;
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

SRVMES:	ASCIE </CAN'T UNDERSTAND NOTE FROM THE 10/>

;  DOGTBUF, DOUSBUF, DORLBUF

DOGTBUF:
COMMENT ⊗ Called by SERVER.  The 10 wants us to allocate a buffer.
R0 = LOC[note].  The size in bytes is in ARG1(R0).  We should respond
with BUFALC <size> <adr>.  ⊗
	MOV ARG1(R0),R0	;R0 ← size argument
	MOV R0,-(SP)	;Save size argument
	JSR  PC,GTFREE	;Get the buffer out of free storage
	MOV R0,-(SP)	;Save buffer address
	MOV #NOTSIZ,R0	;
	JSR PC,GTFREE	;R0 ← LOC[new note to send]
	MOV #BUFALC,(R0)	;BUFALC
	MOV (SP)+,ARG2(R0) 	;  <adr>
	MOV (SP)+,ARG1(R0) 	;  <size>
	JSR PC,SNDNOTE	;Send the note off. (He will destroy it)
	RTS PC		;Done

DOUSBUF:
COMMENT ⊗ Called by SERVER.  R0 = LOC[note].  The buffer that starts
at address ARG1(R0) is a message.  Look at it, act on it, and then
recycle the message buffer.  ⊗
	MOV ARG1(R0),R0	;R0 ← LOC[message]
	JSR PC,TREATIT	;Treat it and release it
	RTS PC		;Done

DORLBUF:
COMMENT ⊗ Called by SERVER.  R0 = LOC[note].  The buffer that starts
at ARG1(R0) has been used by the 10, and we may deallocate it now. ⊗
	MOV ARG1(R0),R0	;R0 ← LOC[expended message]
	JSR PC,RLFREE	;
	RTS PC		;Done
;  TREATMESSAGE

TREATMESSAGE:
COMMENT ⊗ R0 = LOC[buffer from the 10].  Print out its contents and
treat it.  ⊗
	MOV R2,-(SP)	;Save R2
	MOV R0,R2	;R2 ← LOC[buffer]

	;print the message
	ADD #MESBEG,R0	;R0 ← LOC[start of message itself]
	JSR PC,TYPSTR	;Print it

	;see what kind of message it is
	MOV R2,R0	;
	ADD #MESBEG,R0	;R0 ← LOC[start of message itself]
	JSR PC,LOOKUP	;This will perform the desired action.
	
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Eventually, the 10 will give us back the buffer,
			;and we will discard it.
;  Driver for test of communications
	PUTLOC JOBDAT, MAINBL
	PUTLOC JOBSA, START
MAINBL:	PDBLK 400,S	;Makes a process descriptor for main process
START:	JSR PC,IOINIT	;
	JSR PC,FRINIT	;
	CLR NOTB10	;
	CLR NOTB11	;
	JSR PC,SERVER	;We exist but to serve
	BR .-4
.END
! new stuff:  KTABLE, LOOKUP;

	.MACRO KWORD KNAME, KADDR
	II == .
	ASCIE /ANAME/
	. = II + 6	;Truncate to 6 characters
	KADDR		;The address of the service routine
	
KTABLE:
	II == 0
	KWORD GETVAL, DOGETVAL
	KWORD ISVAL, DOISVAL
KTEND:	.WORD 0

COMMENT ⊗ R0 ← LOC[string].  Find which keyword heads the string, and
call the appropriate routine for that keyword. ⊗

LOOKUP:	; Use a disgusting linear search
	MOV R2,-(SP)	;Save R2
	CLR R1		;R1 ← Offset into KTABLE
LKP2:	CMP (R0),KTABLE(R1)	;Match the first 2 letters?
	BEQ LKP1	;Yes
LKP3:	ADD #10,R1	;Try next entry
	INC R1		;
	CMP R1,KTLTH	;Off the end?
	BLT LKP2	;No.
	BR LKP4		;Yes.
LKP1:	CMP 2(R0),KTABLE+2(R1)	;Match the next 2 letters?
	BNE LKP3	;No
	CMP 4(R0),KTABLE+4(R1)	;Match the last 2 letters?
	BNE LKP3	;No
	ADD #6,R0	;R0 ← end of key
LKP4:	CMPB (R0)+,#40	;Skip spaces
	BEQ LKP5	;
	DEC R0		;
	JSR PC,@10(R1)	;Call the indicated routine
	MOV (SP)+,R2	;Restore R2
	RST PC		;Done